Import from Excel

HCL Notes/Domino 8.5 Forum (includes Notes Traveler)

Subject:

Import from Excel

Here is something from a project a few years ago....

Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim uName As NotesName
Dim pndoc As NotesDocument
Dim pndoc1 As NotesDocument
Dim pnview As NotesView
Dim pnview1 As NotesView

Set db=session.CurrentDatabase
Set uName = session.CreateName(session.EffectiveUserName)
Set pnview = db.GetView("byOldPN")
Set pnview1 = db.GetView("byNewPN")

ExcelFile=Inputbox$("Enter Excel File","Excel Import","c:\temp\test.xls")

Set xls=GetObject(ExcelFile,"")

Set sheet = xls.Worksheets(1)
SheetName$=Trim(sheet.name)

x% = 0
Do While True
With sheet
x% = x% + 1
CellValueA$=sheet.range("A"+Ltrim(Str$(x%))).value 'old pn
CellValueB$=sheet.range("B"+Ltrim(Str$(x%))).value 'new pn
CellValueC$=sheet.range("C"+Ltrim(Str$(x%))).value 'old desc
CellValueD$=sheet.range("D"+Ltrim(Str$(x%))).value 'new desc

If Not Lcase(Fulltrim( CellValueA$ ))= "old item number" Then

If Not ( CellValueA$ = "" _
And CellValueB$ = "" _
And CellValueC$ = "" _
And CellValueD$ = "" ) Then

Call pnview.Refresh
Set pndoc = pnview.GetDocumentByKey(CellValueA$ , True)
If Not pndoc Is Nothing Then
Print "Duplicate Old Part Number: " & CellValueA$

End If
Call pnview1.Refresh
Set pndoc1 = pnview1.GetDocumentByKey(CellValueB$ , True)
If Not pndoc1 Is Nothing Then
Print "Duplicate NEW Part Number: " & CellValueB$

End If

Set doc = db.CreateDocument
doc.form = "XRef"
doc.OldPN = Fulltrim(CellValueA$)
doc.OldDesc = Fulltrim(CellValueC$)
doc.NewPN = Ucase(Fulltrim(CellValueB$))
doc.NewDesc = Fulltrim(CellValueD$)

' doc.Author = uName.Abbreviated
doc.Author = "Imported from test.xls"
doc.DateCreated = Format(Cstr(Now), "mm/dd/yyyy hh:mm AM/PM" )
doc.EditHistory = Format(Cstr(Now), "mm/dd/yyyy hh:mm AM/PM" ) & " by " & uName.Abbreviated

Call doc.save (True, True)

Print CellValueA$ & " completed..."

Delete doc
j% = j% + 1
' Print CellValueA$ & " completed..." & j% & " documents imported."
Else
Blank% = Blank% + 1
If Blank% = 10 Then Goto Finished
End If
End If

DupPN:
Set pndoc = Nothing
Set pndoc1 = Nothing
End With
Loop
Finished:

Set xls = Nothing
Print "Import complete! " & j% & " documents created"

End Sub

Feedback response number WEBB8UDJSK created by ~Sigmund Dworelitnivu on 05/17/2012